home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / C / Applications / DataScope 2.0.3 / DataScope2l / DSSource / fn_fcomp.c < prev    next >
Encoding:
Text File  |  1994-05-04  |  28.9 KB  |  959 lines  |  [TEXT/MPS ]
  1. /*
  2.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  3.     calc    Recursive calculation routine.  Tries to preserve memory by
  4.             not expanding constants until the last minute.
  5.             Heuristically traverses to the right first to minimize
  6.             memory usage.  Allocates left and right buffers as autos,
  7.             but forces malloc to allocate all arrays which are used for
  8.             calculations.  When temporary space is done with, frees the
  9.             memory required to do the calcs.
  10.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  11. */
  12. calc(n, a)
  13.         node        *n;
  14.         WORKING     *a;
  15. {
  16.         WORKING     d,    e;
  17.         void        fn_one(),    fn_two(),    ErrorAlert();
  18.     
  19.         if (calcidle())                /*  check for user abort */
  20.            {a->stype = SSTOP;
  21.              return;
  22.            }
  23.     
  24.         e.stype        = SBLANK;
  25.         e.talloc    = 0;
  26.         e.dat        = NULL;
  27.     
  28.         d.stype        = SBLANK;
  29.         d.talloc    = 0;
  30.         d.dat        = NULL;
  31.  
  32.         a->talloc    = 0;
  33.         a->dat        = NULL;
  34.     
  35.         if (n->right)    calc(n->right,&e);
  36.         if (n->left)    calc(n->left, &d);
  37.         
  38.         if         (e.stype == SSTOP || d.stype == SSTOP)    a->stype = SSTOP;
  39.         else if (e.stype == SERR  || d.stype == SERR)    a->stype = SERR;
  40.         else if (n->token == TFLOAT)
  41.                 {a->stype = SCONST;
  42.                  a->cval  = n->constv;
  43.                 }
  44.         else if ( n->token == TIDENT )
  45.                 {struct Mwin *tw,*findvar();
  46.                   if (NULL != (tw = findvar(n->var)))
  47.                     {a->stype    = SARRAY;
  48.                      a->dat        = tw->dat;    /* borrow record from window */
  49.                       a->dimx    = a->dat->xdim;
  50.                       a->dimy    = a->dat->ydim;
  51.                       a->talloc     = 0;
  52.                     }
  53.                   else
  54.                       {a->stype    = SERR;        /* indicate error condition */
  55.                         a->dat    = NULL;
  56.                        ErrorAlert(GetResource('STR ',1015));
  57.                       }
  58.                 }
  59.         else if ( n->token == TFN)             fn_one (n->var, &d,a);
  60.         else if ( n->token == UMINUS)         fn_one ("umin", &d,a);
  61.         else if ( n->token == TFN2)             fn_two (n->var, &d,&e,a);
  62.         else
  63.             {if         ( n->token == TPLUS)     fn_two ("plus", &d,&e,a);
  64.              else if ( n->token == TMINUS)     fn_two ("minus",&d,&e,a);
  65.              else if ( n->token == TSTAR)     fn_two ("star", &d,&e,a);
  66.              else if ( n->token == TSLASH)     fn_two ("slash",&d,&e,a);
  67.              else
  68.                 {a->stype = SERR;
  69.                  ErrorAlert(GetResource('STR ',1014));
  70.                 }
  71.             }
  72.         if (d.talloc && d.stype == SARRAY)     losedat(d.dat);
  73.         if (e.talloc && e.stype == SARRAY)    losedat(e.dat);
  74.         return;
  75. }
  76. /*
  77.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  78.     fn_one        handle computational, single input, single output functions
  79.                 s = pointer to character string
  80.                 d = pointer to source data
  81.                 a = pointer to output data
  82.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  83. */
  84. void fn_one(s,d,a)        char    *s;
  85.                         WORKING    *d,*a;
  86. {
  87.         register float        *p,*q,*t;
  88.         register extended    z,y,*m;
  89.         register int        n;
  90.  
  91. float    fn_sdev(),    fn_mean(),    fn_max(),    fn_min(),
  92.         fn_stpsd();
  93.         
  94. void    fn_dx1c(),    fn_dxv(),    fn_dy1c(),    fn_dyv(),
  95.         fn_dx2c(),    fn_dy2c(),    fn_lap5c(),    fn_lap9c(),
  96.         fn_coef1(),    fn_coef2(),    fn_medn9(), fn_transpose(),
  97.         fn_shd(),    fn_shl(),    fn_shr(),    fn_shu(),
  98.         unknown(),    ErrorAlert();
  99.         
  100.  
  101.         z = asin(.5) / 30.;
  102.         y = log(10.);
  103.  
  104.         if (d->stype == SCONST)
  105.             
  106.             {a->stype = SCONST;
  107.              if         (!ncstrcmp(s,"sin"))
  108.                       a->cval = (float)(sin((extended)(d->cval)));
  109.              else if (!ncstrcmp(s,"cos"))
  110.                       a->cval = (float)(cos((extended)(d->cval)));
  111.              else if (!ncstrcmp(s,"tan"))
  112.                       a->cval = (float)(tan((extended)(d->cval)));
  113.              else if (!ncstrcmp(s,"asin"))
  114.                       a->cval = (float)(asin((extended)(d->cval)));
  115.              else if (!ncstrcmp(s,"acos"))
  116.                       a->cval = (float)(acos((extended)(d->cval)));
  117.              else if (!ncstrcmp(s,"atan"))
  118.                       a->cval = (float)(atan((extended)(d->cval)));
  119.              else if (!ncstrcmp(s,"sinh"))
  120.                       a->cval = (float)(sinh((extended)(d->cval)));
  121.              else if (!ncstrcmp(s,"cosh"))
  122.                       a->cval = (float)(cosh((extended)(d->cval)));
  123.              else if (!ncstrcmp(s,"tanh"))
  124.                       a->cval = (float)(tanh((extended)(d->cval)));
  125.              
  126.              else if (!ncstrcmp(s,"dtor"))
  127.                       a->cval = (float)((extended)(d->cval) * z);
  128.              else if (!ncstrcmp(s,"rtod"))
  129.                       a->cval = (float)((extended)(d->cval) / z);
  130.              
  131.              else if (!ncstrcmp(s,"dsin"))
  132.                       a->cval = (float) (sin((extended)(d->cval) * z));
  133.              else if (!ncstrcmp(s,"dcos"))
  134.                       a->cval = (float) (cos((extended)(d->cval) * z));
  135.              else if (!ncstrcmp(s,"dtan"))
  136.                       a->cval = (float) (tan((extended)(d->cval) * z));
  137.              else if (!ncstrcmp(s,"dasin"))
  138.                       a->cval = (float)(asin((extended)(d->cval)) / z);
  139.              else if (!ncstrcmp(s,"dacos"))
  140.                       a->cval = (float)(acos((extended)(d->cval)) / z);
  141.              else if (!ncstrcmp(s,"datan"))
  142.                       a->cval = (float)(atan((extended)(d->cval)) / z);
  143.              else if (!ncstrcmp(s,"dsinh"))
  144.                       a->cval = (float)(sinh((extended)(d->cval) * z));
  145.              else if (!ncstrcmp(s,"dcosh"))
  146.                       a->cval = (float)(cosh((extended)(d->cval) * z));
  147.              else if (!ncstrcmp(s,"dtanh"))
  148.                       a->cval = (float)(tanh((extended)(d->cval) * z));
  149.              
  150.              else if (!ncstrcmp(s,"sqrt" ))
  151.                       a->cval = (float)(sqrt((extended)(d->cval)));
  152.              else if (!ncstrcmp(s,"log"  ))
  153.                       a->cval = (float)(log((extended)(d->cval)));
  154.              else if (!ncstrcmp(s,"log10"))
  155.                       a->cval = (float)(log((extended)(d->cval)) / y);
  156.              else if (!ncstrcmp(s,"exp"  ))
  157.                       a->cval = (float)(exp((extended)(d->cval)));
  158.              else if (!ncstrcmp(s,"colrange"))    a->cval = 0.;
  159.              else if (!ncstrcmp(s,"rowrange"))    a->cval = 0.;
  160.              else if (!ncstrcmp(s,"pts"  ))        a->cval = 1.;
  161.              else if (!ncstrcmp(s,"cols" ))        a->cval = 1.;
  162.              else if (!ncstrcmp(s,"rows" ))        a->cval = 1.;
  163.              else if (!ncstrcmp(s,"abs"  ))
  164.                       {if (d->cval > 0)        a->cval =    d->cval;
  165.                       else                    a->cval = - d->cval;
  166.                      }
  167.              
  168.              else if (!ncstrcmp(s,"mean"))    a->cval = d->cval;
  169.              else if (!ncstrcmp(s,"max" ))    a->cval = d->cval;
  170.              else if (!ncstrcmp(s,"min" ))    a->cval = d->cval;
  171.              else if (!ncstrcmp(s,"umin"))    a->cval = - d->cval;
  172.              else if (!ncstrcmp(s,"shl"))    a->cval = d->cval;
  173.              else if (!ncstrcmp(s,"shr"))    a->cval = d->cval;
  174.              else if (!ncstrcmp(s,"shu"))    a->cval = d->cval;
  175.              else if (!ncstrcmp(s,"shd"))    a->cval = d->cval;
  176.              
  177.              else if (!ncstrcmp(s,"dx1c"))    a->cval = 0.;
  178.              else if (!ncstrcmp(s,"ddx"))    a->cval = 0.;
  179.              else if (!ncstrcmp(s,"dy1c"))    a->cval = 0.;
  180.              else if (!ncstrcmp(s,"ddy"))    a->cval = 0.;
  181.              else if (!ncstrcmp(s,"dx2c"))    a->cval = 0.;
  182.              else if (!ncstrcmp(s,"d2dx"))    a->cval = 0.;
  183.              else if (!ncstrcmp(s,"dy2c"))    a->cval = 0.;
  184.              else if (!ncstrcmp(s,"d2dy"))    a->cval = 0.;
  185.              else if (!ncstrcmp(s,"lap"))    a->cval = 0.;
  186.              else if (!ncstrcmp(s,"lap5"))    a->cval = 0.;
  187.              else if (!ncstrcmp(s,"lap9"))    a->cval = 0.;
  188.              else                            unknown(s,d,NULL,a);
  189.             }
  190.             
  191.         else if (!ncstrcmp(s,"max"))
  192.                 {a->stype = SCONST;
  193.                  a->cval = fn_max (d->dat->vals,d->dimx * d->dimy);
  194.                 }
  195.         else if (!ncstrcmp(s,"min"))
  196.                 {a->stype = SCONST;
  197.                  a->cval = fn_min (d->dat->vals,d->dimx * d->dimy);
  198.                 }
  199.         else if (!ncstrcmp(s,"mean"))
  200.                 {a->stype = SCONST;
  201.                  a->cval = fn_mean(d->dat->vals,d->dimx * d->dimy);
  202.                 }
  203.         else if (!ncstrcmp(s,"sdev"))
  204.                 {if      (d->dimx * d->dimy < 2)
  205.                       {a->stype = SERR;
  206.                        ErrorAlert(GetResource('STR ',1013));
  207.                       }
  208.                  else
  209.                        {a->stype = SCONST;
  210.                         a->cval = fn_sdev(d->dat->vals,d->dimx * d->dimy);
  211.                       }
  212.                 }
  213.         else if (!ncstrcmp(s,"colsdev"))
  214.                 {if (d->dimx < 3)
  215.                     {a->stype = SERR;
  216.                      ErrorAlert(GetResource('STR ',1013));
  217.                     }
  218.                  else
  219.                        {a->stype = SCONST;
  220.                         a->cval = fn_stpsd(d->dat->xvals,d->dimx);
  221.                       }
  222.                 }
  223.         else if (!ncstrcmp(s,"colsmean"))
  224.                 {a->stype = SCONST;
  225.                  a->cval = (float)(((extended)(*(d->dat->xvals + d->dimx - 1)) -
  226.                              (extended)(*(d->dat->xvals))) / (extended)(d->dimx - 1));
  227.                 }
  228.         else if (!ncstrcmp(s,"rowsdev"))
  229.                 {if (d->dimy < 3)
  230.                     {a->stype = SERR;
  231.                      ErrorAlert(GetResource('STR ',1013));
  232.                     }
  233.                  else
  234.                        {a->stype = SCONST;
  235.                         a->cval = fn_stpsd(d->dat->yvals,d->dimy);
  236.                       }
  237.                 }
  238.         else if (!ncstrcmp(s,"rowsmean"))
  239.                 {a->stype = SCONST;
  240.                  a->cval = (float)(((extended)(*(d->dat->yvals + d->dimy - 1)) -
  241.                              (extended)(*(d->dat->yvals))) / (extended)(d->dimy - 1));
  242.                 }
  243.         else if (!ncstrcmp(s,"cols"))
  244.                 {a->stype = SCONST;
  245.                  a->cval = (float)(d->dimx);
  246.                 }
  247.         else if (!ncstrcmp(s,"rows"))
  248.                 {a->stype = SCONST;
  249.                  a->cval = (float)(d->dimy);
  250.                 }
  251.         else if (!ncstrcmp(s,"pts"))
  252.                 {a->stype = SCONST;
  253.                  a->cval = (float)(d->dimx * d->dimy);
  254.                 }
  255.         else if (!ncstrcmp(s,"colrange"))
  256.                 {a->stype = SCONST;
  257.                  a->cval = (float)((extended)(*(d->dat->xvals + d->dimx - 1)) -
  258.                                     (extended)(*(d->dat->xvals)));
  259.                 }
  260.         else if (!ncstrcmp(s,"rowrange"))
  261.                 {a->stype = SCONST;
  262.                  a->cval = (float)((extended)(*(d->dat->yvals + d->dimy - 1)) -
  263.                                     (extended)(*(d->dat->yvals)));
  264.                 }
  265.         else
  266.                 {if    (0 > useormalloc(d,a))    return;
  267.                  else
  268.                      {n = d->dimx * d->dimy;
  269.                       p = d->dat->vals;
  270.                       q = p + n - 1;
  271.                       t = a->dat->vals;
  272.                      if            (!ncstrcmp(s,"sin"))
  273.                                   {while (p < q)
  274.                                        *t++ = (float)(sin((extended)(*p++)));
  275.                                    *t = (float)(sin((extended)(*p)));
  276.                                  }
  277.                      else if    (!ncstrcmp(s,"cos"))
  278.                                   {while (p < q)
  279.                                        *t++ = (float)(cos((extended)(*p++)));
  280.                                   *t = (float)(cos((extended)(*p)));
  281.                                  }
  282.                      else if    (!ncstrcmp(s,"tan"))
  283.                                   {while (p < q)
  284.                                        *t++ = (float)(tan((extended)(*p++)));
  285.                                   *t = (float)(tan((extended)(*p)));
  286.                                  }
  287.                      else if    (!ncstrcmp(s,"asin"))
  288.                                   {while (p < q)
  289.                                        *t++ = (float)(asin((extended)(*p++)));
  290.                                    *t = (float)(asin((extended)(*p)));
  291.                                  }
  292.                      else if    (!ncstrcmp(s,"acos"))
  293.                                   {while (p < q)
  294.                                        *t++ = (float)(acos((extended)(*p++)));
  295.                                   *t = (float)(acos((extended)(*p)));
  296.                                  }
  297.                      else if    (!ncstrcmp(s,"atan"))
  298.                                   {while (p < q)
  299.                                        *t++ = (float)(atan((extended)(*p++)));
  300.                                   *t = (float)(atan((extended)(*p)));
  301.                                  }
  302.                      else if    (!ncstrcmp(s,"sinh"))
  303.                                   {while (p < q)
  304.                                        *t++ = (float)(sinh((extended)(*p++)));
  305.                                    *t = (float)(sinh((extended)(*p)));
  306.                                  }
  307.                      else if    (!ncstrcmp(s,"cosh"))
  308.                                   {while (p < q)
  309.                                        *t++ = (float)(cosh((extended)(*p++)));
  310.                                   *t = (float)(cosh((extended)(*p)));
  311.                                  }
  312.                      else if    (!ncstrcmp(s,"tanh"))
  313.                                   {while (p < q)
  314.                                        *t++ = (float)(tanh((extended)(*p++)));
  315.                                   *t = (float)(tanh((extended)(*p)));
  316.                                  }
  317.                  
  318.                      else if    (!ncstrcmp(s,"dsin"))
  319.                                   {while (p < q)
  320.                                        *t++ = (float)(sin((extended)(*p++) * z));
  321.                                    *t = (float)(sin((extended)(*p) * z));
  322.                                  }
  323.                      else if    (!ncstrcmp(s,"dcos"))
  324.                                   {while (p < q)
  325.                                        *t++ = (float)(cos((extended)(*p++) * z));
  326.                                   *t = (float)(cos((extended)(*p) * z));
  327.                                  }
  328.                      else if    (!ncstrcmp(s,"dtan"))
  329.                                   {while (p < q)
  330.                                        *t++ = (float)(tan((extended)(*p++) * z));
  331.                                   *t = (float)(tan((extended)(*p) * z));
  332.                                  }
  333.                      else if    (!ncstrcmp(s,"dasin"))
  334.                                   {while (p < q)
  335.                                        *t++ = (float)(asin((extended)(*p++)) / z);
  336.                                    *t = (float)(asin((extended)(*p)) / z);
  337.                                  }
  338.                      else if    (!ncstrcmp(s,"dacos"))
  339.                                   {while (p < q)
  340.                                        *t++ = (float)(acos((extended)(*p++)) / z);
  341.                                   *t = (float)(acos((extended)(*p)) / z);
  342.                                  }
  343.                      else if    (!ncstrcmp(s,"datan"))
  344.                                   {while (p < q)
  345.                                        *t++ = (float)(atan((extended)(*p++)) / z);
  346.                                   *t = (float)(atan((extended)(*p)) / z);
  347.                                  }
  348.                      else if    (!ncstrcmp(s,"dsinh"))
  349.                                   {while (p < q)
  350.                                        *t++ = (float)(sinh((extended)(*p++) * z));
  351.                                    *t = (float)(sinh((extended)(*p) * z));
  352.                                  }
  353.                      else if    (!ncstrcmp(s,"dcosh"))
  354.                                   {while (p < q)
  355.                                        *t++ = (float)(cosh((extended)(*p++) * z));
  356.                                   *t = (float)(cosh((extended)(*p) * z));
  357.                                  }
  358.                      else if    (!ncstrcmp(s,"dtanh"))
  359.                                   {while (p < q)
  360.                                        *t++ = (float)(tanh((extended)(*p++) * z));
  361.                                   *t = (float)(tanh((extended)(*p) * z));
  362.                                  }
  363.             
  364.                      else if    (!ncstrcmp(s,"dtor"))
  365.                                   {while (p < q)
  366.                                        *t++ = (float)((extended)(*p++) * z);
  367.                                   *t = (float)((extended)(*p) * z);
  368.                                  }
  369.                      else if    (!ncstrcmp(s,"rtod"))
  370.                                   {while (p < q)
  371.                                        *t++ = (float)((extended)(*p++) / z);
  372.                                   *t = (float)((extended)(*p) / z);
  373.                                  }
  374.                                 
  375.                      else if    (!ncstrcmp(s,"sqrt"))
  376.                                   {while (p < q)
  377.                                        *t++ = (float)(sqrt((extended)(*p++)));
  378.                                   *t = (float)(sqrt((extended)(*p)));
  379.                                  }
  380.                      else if    (!ncstrcmp(s,"log"))
  381.                                   {while (p < q)
  382.                                        *t++ = (float)(log((extended)(*p++)));
  383.                                   *t = (float)(log((extended)(*p)));
  384.                                  }
  385.                      else if    (!ncstrcmp(s,"log10"))
  386.                                   {while (p < q)
  387.                                        *t++ = (float)(log((extended)(*p++)) / y);
  388.                                   *t = (float)(log((extended)(*p)) / y);
  389.                                  }
  390.                      else if    (!ncstrcmp(s,"exp"))
  391.                                   {while (p < q)
  392.                                        *t++ = (float)(exp((extended)(*p++)));
  393.                                   *t = (float)(exp((extended)(*p)));
  394.                                  }
  395.                      else if    (!ncstrcmp(s,"abs"))
  396.                                   {while (p < q)
  397.                                        {if (*p < 0) *t++ = - *p++;
  398.                                         else        *t++ =   *p++;
  399.                                        }
  400.                                  if (*p < 0) *t = - *p;
  401.                                  else         *t =   *p;
  402.                                  }
  403.                      else if    (!ncstrcmp(s,"umin"))
  404.                                   {while (p < q) *t++ = - *p++;
  405.                                   *t = - *p;
  406.                                  }
  407.              
  408.                     else if (!ncstrcmp(s,"shl"))     fn_shl(p,q,t,d->dimx);
  409.                     else if (!ncstrcmp(s,"shr"))     fn_shr(p,q,t,d->dimx);
  410.                     else if (!ncstrcmp(s,"shu"))     fn_shu(p,q,t,d->dimx);
  411.                     else if (!ncstrcmp(s,"shd"))     fn_shd(p,q,t,d->dimx);
  412.                     
  413.                     else if (!ncstrcmp(s,"transpose"))    
  414.                             {                                    /* copy data anew */
  415.                              if    (0 > cloneornot(d,a))    return;
  416.                               fn_transpose(d->dat->vals,
  417.                                                  a->dat->vals,
  418.                                                  d->dimx,
  419.                                                  d->dimy);
  420.                             p = a->dat->xvals;                    /* swap x and y */
  421.                             a->dat->xvals = a->dat->yvals;
  422.                             a->dat->yvals = p;
  423.                             n = a->dat->xdim;                    /* swap dimensions */
  424.                             a->dimx = a->dat->xdim = a->dat->ydim;
  425.                             a->dimy = a->dat->ydim = n;
  426.                             
  427.                             }
  428.                     
  429.                     else if (!ncstrcmp(s,"medn9"))
  430.                             {if (d->dimx < 3 || d->dimy < 3)
  431.                                 {a->stype = SERR;
  432.                                  ErrorAlert(GetResource('STR ',1013));
  433.                                 }
  434.                              else
  435.                                  {
  436.                                  TickCount();
  437.                                    if    (0 > cloneornot(d,a))    return;
  438.                                    fn_medn9(d->dat->vals,
  439.                                                    a->dat->vals,
  440.                                                   d->dimx,
  441.                                                   d->dimx * d->dimy);
  442.                                  }
  443.                             }
  444.                     
  445.                     else if (!ncstrcmp(s,"dx1c"))
  446.                             {if (d->dimx < 3)
  447.                                 {a->stype = SERR;
  448.                                  ErrorAlert(GetResource('STR ',1013));
  449.                                 }
  450.                              else
  451.                                    {z = .5 * (extended)(d->dimx - 1) /
  452.                                          ((extended)(*(d->dat->xvals + d->dimx - 1)) -
  453.                                        (extended)(*(d->dat->xvals)));
  454.                                    if (*(d->dat->xvals + d->dimx - 1) <
  455.                                           *(d->dat->xvals))    z = - z;
  456.                                     if    (0 > cloneornot(d,a))    return;
  457.                                     fn_dx1c (d->dat->vals,
  458.                                                       a->dat->vals,
  459.                                                    d->dimx,
  460.                                                    d->dimx * d->dimy,
  461.                                                    z);
  462.                                   }
  463.                             }
  464.                     else if (!ncstrcmp(s,"dx2c"))
  465.                             {if (d->dimx < 3)
  466.                                 {a->stype = SERR;
  467.                                  ErrorAlert(GetResource('STR ',1013));
  468.                                 }
  469.                              else
  470.                                    {z = (extended)(d->dimx - 1) /
  471.                                          ((extended)(*(d->dat->xvals + d->dimx - 1)) -
  472.                                        (extended)(*(d->dat->xvals)));
  473.                                    z *= z;
  474.                                     if    (0 > cloneornot(d,a))    return;
  475.                                     fn_dx2c (d->dat->vals,
  476.                                                       a->dat->vals,
  477.                                                    d->dimx,
  478.                                                    d->dimx * d->dimy,
  479.                                                    z);
  480.                                   }
  481.                             }
  482.                     else if (!ncstrcmp(s,"dy1c"))
  483.                             {if (d->dimy < 3)
  484.                                 {a->stype = SERR;
  485.                                  ErrorAlert(GetResource('STR ',1013));
  486.                                 }
  487.                              else
  488.                                    {z = .5 * (extended)(d->dimy - 1) /
  489.                                          ((extended)(*(d->dat->yvals + d->dimy - 1)) -
  490.                                        (extended)(*(d->dat->yvals)));
  491.                                    if (*(d->dat->yvals + d->dimy - 1) <
  492.                                           *(d->dat->yvals))    z = - z;
  493.                                     if    (0 > cloneornot(d,a))    return;
  494.                                     fn_dy1c (d->dat->vals,
  495.                                                       a->dat->vals,
  496.                                                    d->dimx,
  497.                                                    d->dimx * d->dimy,
  498.                                                    z);
  499.                                   }
  500.                             }
  501.                     else if (!ncstrcmp(s,"dy2c"))
  502.                             {if (d->dimy < 3)
  503.                                 {a->stype = SERR;
  504.                                  ErrorAlert(GetResource('STR ',1013));
  505.                                 }
  506.                              else
  507.                                    {z = (extended)(d->dimy - 1) /
  508.                                          ((extended)(*(d->dat->yvals + d->dimy - 1)) -
  509.                                        (extended)(*(d->dat->yvals)));
  510.                                    z *= z;
  511.                                     if    (0 > cloneornot(d,a))    return;
  512.                                     fn_dy2c (d->dat->vals,
  513.                                                       a->dat->vals,
  514.                                                    d->dimx,
  515.                                                    d->dimx * d->dimy,
  516.                                                    z);
  517.                                   }
  518.                             }
  519.                     else if (!ncstrcmp(s,"ddx"))
  520.                             {if (d->dimx < 3)
  521.                                 {a->stype = SERR;
  522.                                  ErrorAlert(GetResource('STR ',1013));
  523.                                  return;
  524.                                 }
  525.                              if (checkmem(2 * d->dimx * sizeof(extended)))
  526.                                 return;
  527.                              if (NULL == (m = (extended *)
  528.                                            NewPtr(2 * d->dimx * sizeof(extended))))
  529.                                    {nomem();
  530.                                     return;
  531.                                    }
  532.                              if    (0 > cloneornot(d,a))    return;
  533.                                  fn_coef1(d->dat->xvals,m,d->dimx);
  534.                               fn_dxv(d->dat->vals,
  535.                                             a->dat->vals,
  536.                                            d->dimx,
  537.                                            d->dimy,
  538.                                            m);
  539.                              DisposPtr    ( (Ptr) m);
  540.                             }
  541.  
  542.                     else if (!ncstrcmp(s,"d2dx"))
  543.                             {if (d->dimx < 3)
  544.                                 {a->stype = SERR;
  545.                                  ErrorAlert(GetResource('STR ',1013));
  546.                                  return;
  547.                                 }
  548.                              if (checkmem(2 * d->dimx * sizeof(extended)))
  549.                                 return;
  550.                              if (NULL == (m = (extended *)
  551.                                            NewPtr(2 * d->dimx * sizeof(extended))))
  552.                                    {nomem();
  553.                                     return;
  554.                                    }
  555.                              if    (0 > cloneornot(d,a))    return;
  556.                                  fn_coef2(d->dat->xvals,m,d->dimx);
  557.                               fn_dxv(d->dat->vals,
  558.                                             a->dat->vals,
  559.                                            d->dimx,
  560.                                            d->dimy,
  561.                                            m);
  562.                              DisposPtr    ((Ptr) m);
  563.                             }
  564.  
  565.                     else if (!ncstrcmp(s,"ddy"))
  566.                             {if (d->dimy < 3)
  567.                                 {a->stype = SERR;
  568.                                  ErrorAlert(GetResource('STR ',1013));
  569.                                  return;
  570.                                 }
  571.                              if (checkmem(2 * d->dimy * sizeof(extended)))
  572.                                 return;
  573.                              if (NULL == (m = (extended *)
  574.                                            NewPtr(2 * d->dimy * sizeof(extended))))
  575.                                    {nomem();
  576.                                     return;
  577.                                    }
  578.                              if    (0 > cloneornot(d,a))    return;
  579.                                  fn_coef1(d->dat->yvals,m,d->dimy);
  580.                               fn_dyv(d->dat->vals,
  581.                                             a->dat->vals,
  582.                                            d->dimx,
  583.                                            d->dimy,
  584.                                            m);
  585.                              DisposPtr    ((Ptr) m);
  586.                             }
  587.  
  588.                     else if (!ncstrcmp(s,"d2dy"))
  589.                             {if (d->dimy < 3)
  590.                                 {a->stype = SERR;
  591.                                   ErrorAlert(GetResource('STR ',1013));
  592.                                  return;
  593.                                 }
  594.                              if (checkmem(2 * d->dimy * sizeof(extended)))
  595.                                 return;
  596.                              if (NULL == (m = (extended *)
  597.                                            NewPtr(2 * d->dimy * sizeof(extended))))
  598.                                    {nomem();
  599.                                     return;
  600.                                    }
  601.                              if    (0 > cloneornot(d,a))    return;
  602.                                  fn_coef2(d->dat->yvals,m,d->dimy);
  603.                               fn_dyv(d->dat->vals,
  604.                                             a->dat->vals,
  605.                                            d->dimx,
  606.                                            d->dimy,
  607.                                            m);
  608.                              DisposPtr    ((Ptr) m);
  609.                             }
  610.  
  611.                     else if (!ncstrcmp(s,"lap5") || !ncstrcmp(s,"lap"))
  612.                             {if (d->dimy < 3 || d->dimx < 3)
  613.                                 {a->stype = SERR;
  614.                                  ErrorAlert(GetResource('STR ',1013));
  615.                                 }
  616.                              else
  617.                                    {z = (extended)(d->dimx - 1) /
  618.                                          ((extended)(*(d->dat->xvals + d->dimx - 1)) -
  619.                                        (extended)(*(d->dat->xvals)));
  620.                                    z *= z;
  621.                                     y = (extended)(d->dimy - 1) /
  622.                                          ((extended)(*(d->dat->yvals + d->dimy - 1)) -
  623.                                        (extended)(*(d->dat->yvals)));
  624.                                    y *= y;
  625.                                     if    (0 > cloneornot(d,a))    return;
  626.                                     fn_lap5c    (d->dat->vals,
  627.                                                         a->dat->vals,
  628.                                                      d->dimx,
  629.                                                      d->dimx * d->dimy,
  630.                                                      z,
  631.                                                      y);
  632.                                   }
  633.                             }
  634.                     else if (!ncstrcmp(s,"lap9"))
  635.                             {if (d->dimy < 3 || d->dimx < 3)
  636.                                 {a->stype = SERR;
  637.                                  ErrorAlert(GetResource('STR ',1013));
  638.                                 }
  639.                              else
  640.                                    {z = (extended)(d->dimx - 1) /
  641.                                          ((extended)(*(d->dat->xvals + d->dimx - 1)) -
  642.                                        (extended)(*(d->dat->xvals)));
  643.                                    z *= z;
  644.                                     y = (extended)(d->dimy - 1) /
  645.                                          ((extended)(*(d->dat->yvals + d->dimy - 1)) -
  646.                                        (extended)(*(d->dat->yvals)));
  647.                                    y *= y;
  648.                                    
  649.                                    z = .5 * (z + y);
  650.                                    z *= .25;
  651.                                     if    (0 > cloneornot(d,a))    return;
  652.                                     fn_lap9c    (d->dat->vals,
  653.                                                         a->dat->vals,
  654.                                                      d->dimx,
  655.                                                      d->dimx * d->dimy,
  656.                                                      z);
  657.                                   }
  658.                             }
  659.  
  660. /*
  661.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  662.     We don't have a function by this name.  Look for an external function.
  663.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  664. */
  665.                     else    unknown(s,d,NULL,a);
  666.                    }
  667.            }
  668.         return;
  669. }
  670. /*
  671.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  672.     fn_two        handle computational, double input, single output functions
  673.                 s = pointer to character string code
  674.                 d = pointer to left  source data
  675.                 e = pointer to right source data
  676.                 a = pointer to output data
  677.     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  678. */
  679. void fn_two(s,d,e,a)    char        *s;
  680.                         WORKING        *d,*e,*a;
  681. {
  682.         register float        *p,*q,*t,*u;
  683.         register extended    z,y;
  684.         register int        n;
  685.         extended            theK[7 * 7];
  686.         void                DoKernelOperation(),
  687.                             ErrorAlert(),
  688.                             unknown();
  689.         
  690.         z = asin(.5) / 30.;
  691.  
  692.     /*
  693.     *******************************
  694.     kernel operations
  695.     ******************************* 
  696.     */
  697.     if (!ncstrcmp(s,"kernel"))
  698.        {if (d->stype == SCONST || e->stype == SCONST)
  699.            {a->stype = SERR;
  700.             ErrorAlert(GetResource('STR ',1012));
  701.            }
  702.         else if (e->dimx == 3 && e->dimy == 4)
  703.                 {if (d->dimx < 3 ||
  704.                      d->dimy < 3 ||
  705.                      *(e->dat->vals) == 0.)
  706.                     {a->stype = SERR;
  707.                      ErrorAlert(GetResource('STR ',1011));
  708.                     }
  709.                  else
  710.                       {if (useormalloc(d,a) < 0)    return;
  711.                                DoKernelOperation(d->dat->vals,
  712.                                                    a->dat->vals,
  713.                                                  d->dimx,
  714.                                                 d->dimx * d->dimy,
  715.                                                  e->dat->vals,
  716.                                                theK,
  717.                                                3);
  718.                      }
  719.                 }
  720.         else if (e->dimx == 5 && e->dimy == 6)
  721.                 {if (d->dimx < 5 ||
  722.                      d->dimy < 5 ||
  723.                      *(e->dat->vals) == 0.)
  724.                     {a->stype = SERR;
  725.                      ErrorAlert(GetResource('STR ',1011));
  726.                     }
  727.                  else
  728.                       {if (useormalloc(d,a) < 0)    return;
  729.                                DoKernelOperation(d->dat->vals,
  730.                                                    a->dat->vals,
  731.                                                  d->dimx,
  732.                                                  d->dimx * d->dimy,
  733.                                                  e->dat->vals,
  734.                                                theK,
  735.                                                5);
  736.                      }
  737.                 }
  738.         else if (e->dimx == 7 && e->dimy == 8)
  739.                 {if (d->dimx < 7 ||
  740.                      d->dimy < 7 ||
  741.                      *(e->dat->vals) == 0.)
  742.                     {a->stype = SERR;
  743.                      ErrorAlert(GetResource('STR ',1011));
  744.                     }
  745.                  else
  746.                       {if (useormalloc(d,a) < 0)    return;
  747.                                DoKernelOperation(d->dat->vals,
  748.                                                    a->dat->vals,
  749.                                                  d->dimx,
  750.                                                  d->dimx * d->dimy,
  751.                                                 e->dat->vals,
  752.                                                theK,
  753.                                                7);
  754.                      }
  755.                 }
  756.         else
  757.             {a->stype = SERR;
  758.              ErrorAlert(GetResource('STR ',1010));
  759.             }
  760.        }
  761.  
  762.     /*
  763.     *******************************
  764.     constant input, constant output
  765.     ******************************* 
  766.     */
  767.     else if ((d->stype == SCONST) && (e->stype == SCONST))
  768.        {a->stype = SCONST;
  769.         if        (!ncstrcmp(s,"pow"))
  770.                 a->cval = (float)(pow((extended)(d->cval),(extended)(e->cval)));
  771.         else if (!ncstrcmp(s,"atan2"))
  772.                 a->cval = (float)(atan2((extended)(d->cval),(extended)(e->cval)));
  773.         else if (!ncstrcmp(s,"datan2"))
  774.                 a->cval = (float)
  775.                           (atan2((extended)(d->cval),(extended)(e->cval)) / z);
  776.         else if (!ncstrcmp(s,"plus"))
  777.                 a->cval = (float)((extended)(d->cval) + (extended)(e->cval));
  778.         else if (!ncstrcmp(s,"minus"))
  779.                 a->cval = (float)((extended)(d->cval) - (extended)(e->cval));
  780.         else if (!ncstrcmp(s,"star"))
  781.                 a->cval = (float)((extended)(d->cval) * (extended)(e->cval));
  782.         else if (!ncstrcmp(s,"slash"))
  783.                 a->cval = (float)((extended)(d->cval) / (extended)(e->cval));
  784.         else    unknown(s,d,e,a);        
  785.        }
  786.     /*
  787.     *****************************************************
  788.     d is matrix input, e is constant input, matrix output
  789.     *****************************************************
  790.     */
  791.     else if  (e->stype == SCONST)
  792.        {if (0 > useormalloc(d,a)) return;
  793.         n = d->dimx * d->dimy;
  794.         p = d->dat->vals;
  795.         t = a->dat->vals;
  796.         q = p + n - 1;
  797.         y = (extended)(e->cval);
  798.             
  799.         if (!ncstrcmp(s,"pow"))
  800.                 {if (y == 1.)
  801.                     {while (p < q)    *t++ = *p++;
  802.                      *t = *p;
  803.                     }
  804.                  else if (y == 2.)
  805.                     {while (p < q)
  806.                            {*t++ = (float)((extended)(*p) * (extended)(*p));
  807.                             p++;
  808.                            }
  809.                      *t = (float)((extended)(*p) * (extended)(*p));
  810.                     }
  811.                  else if (y == 3.)
  812.                     {while (p < q)
  813.                            {y = (extended)(*p++);
  814.                             *t++ = (float)(y * y * y);
  815.                            }
  816.                      *t = (float)((extended)(*p) * (extended)(*p) * (extended)(*p));
  817.                     }
  818.                  else if (y == 4.)
  819.                     {while (p < q)
  820.                            {y = (extended)(*p++);
  821.                             y *= y;
  822.                             y *= y;
  823.                             *t++ = (float)(y);
  824.                            }
  825.                      y = (extended)(*p);
  826.                      *t = (float)(y * y * y * y);
  827.                     }
  828.                  else
  829.                     {while (p < q)    *t++ = (float)(pow((extended)(*p++),y));
  830.                      *t = (float)(pow((extended)(*p),y));
  831.                     }
  832.                 }
  833.         else if (!ncstrcmp(s,"atan2"))
  834.                 {while (p < q)    *t++ = (float)(atan2((extended)(*p++),y));
  835.                  *t = (float)(atan2((extended)(*p),y));
  836.                 }
  837.         else if (!ncstrcmp(s,"datan2"))
  838.                 {while (p < q)    *t++ = (float)(atan2((extended)(*p++),y) / z);
  839.                  *t = (float)(atan2((extended)(*p),y) / z);
  840.                 }
  841.         else if (!ncstrcmp(s,"plus"))
  842.                 {while (p < q)    *t++ = (float)((extended)(*p++) + y);
  843.                  *t = (float)((extended)(*p) + y);
  844.                 }
  845.         else if (!ncstrcmp(s,"minus"))
  846.                 {while (p < q)    *t++ = (float)((extended)(*p++) - y);
  847.                  *t = (float)((extended)(*p) - y);
  848.                 }
  849.         else if (!ncstrcmp(s,"star"))
  850.                 {while (p < q)    *t++ = (float)((extended)(*p++) * y);
  851.                  *t = (float)((extended)(*p) * y);
  852.                 }
  853.         else if (!ncstrcmp(s,"slash"))
  854.                 {while (p < q)    *t++ = (float)((extended)(*p++) / y);
  855.                  *t = (float)((extended)(*p) / y);
  856.                 }
  857.         else    unknown(s,d,e,a);
  858.        }
  859.     /*
  860.     *****************************************************
  861.     d is constant input, e is matrix input, matrix output
  862.     *****************************************************
  863.     */
  864.     else if  (d->stype == SCONST)
  865.        {if (0 > useormalloc(e,a)) return;
  866.         n = e->dimx * e->dimy;
  867.         p = e->dat->vals;
  868.         t = a->dat->vals;
  869.         q = p + n - 1;
  870.         y = (extended)(d->cval);
  871.             
  872.         if (!ncstrcmp(s,"pow"))
  873.                   {while (p < q)    *t++ = (float)(pow(y,(extended)(*p++)));
  874.                  *t = (float)(pow(y,(extended)(*p)));
  875.                 }
  876.         else if (!ncstrcmp(s,"atan2"))
  877.                 {while (p < q)    *t++ = (float)(atan2(y,(extended)(*p++)));
  878.                  *t = (float)(atan2(y,(extended)(*p)));
  879.                 }
  880.         else if (!ncstrcmp(s,"datan2"))
  881.                 {while (p < q)    *t++ = (float)(atan2(y,(extended)(*p++)) / z);
  882.                  *t = (float)(atan2(y,(extended)(*p)) / z);
  883.                 }
  884.         else if (!ncstrcmp(s,"plus"))
  885.                 {while (p < q)    *t++ = (float)(y + (extended)(*p++));
  886.                  *t = (float)(y + (extended)(*p));
  887.                 }
  888.         else if (!ncstrcmp(s,"minus"))
  889.                 {while (p < q)    *t++ = (float)(y - (extended)(*p++));
  890.                  *t = (float)(y - (extended)(*p));
  891.                 }
  892.         else if (!ncstrcmp(s,"star"))
  893.                 {while (p < q)    *t++ = (float)(y * (extended)(*p++));
  894.                  *t = (float)(y * (extended)(*p));
  895.                 }
  896.         else if (!ncstrcmp(s,"slash"))
  897.                 {while (p < q)    *t++ = (float)(y / (extended)(*p++));
  898.                  *t = (float)(y / (extended)(*p));
  899.                 }
  900.         else    unknown(s,d,e,a);
  901.        }
  902.     /*
  903.     ***************************************************
  904.     d is matrix input, e is matrix input, matrix output
  905.     ***************************************************
  906.     */
  907.     else
  908.        {if (d->dimx != e->dimx || d->dimy != e->dimy)
  909.            {a->stype = SERR;
  910.             ErrorAlert(GetResource('STR ',1009));
  911.             return;
  912.            }
  913.         if (0 > useormalloc(d,a)) return;
  914.         n = e->dimx * e->dimy;
  915.         p = e->dat->vals;
  916.         t = a->dat->vals;
  917.         q = p + n - 1;
  918.         u = d->dat->vals;
  919.             
  920.         if (!ncstrcmp(s,"pow"))
  921.                   {while (p < q)
  922.                      *t++ = (float)(pow((extended)(*u++),(extended)(*p++)));
  923.                  *t = (float)(pow((extended)(*u),(extended)(*p)));
  924.                 }
  925.         else if (!ncstrcmp(s,"atan2"))
  926.                 {while (p < q)
  927.                        *t++ = (float)(atan2((extended)(*u++),(extended)(*p++)));
  928.                  *t = (float)(atan2((extended)(*u),(extended)(*p)));
  929.                 }
  930.         else if (!ncstrcmp(s,"datan2"))
  931.                 {while (p < q)
  932.                        *t++ = (float)(atan2((extended)(*u++),(extended)(*p++)) / z);
  933.                  *t = (float)(atan2((extended)(*u),(extended)(*p)) / z);
  934.                 }
  935.         else if (!ncstrcmp(s,"plus"))
  936.                 {while (p < q)
  937.                        *t++ = (float)((extended)(*u++) + (extended)(*p++));
  938.                  *t = (float)((extended)(*u) + (extended)(*p));
  939.                 }
  940.         else if (!ncstrcmp(s,"minus"))
  941.                 {while (p < q)
  942.                        *t++ = (float)((extended)(*u++) - (extended)(*p++));
  943.                  *t = (float)((extended)(*u) - (extended)(*p));
  944.                 }
  945.         else if (!ncstrcmp(s,"star"))
  946.                 {while (p < q)
  947.                        *t++ = (float)((extended)(*u++) * (extended)(*p++));
  948.                  *t = (float)((extended)(*u) * (extended)(*p));
  949.                 }
  950.         else if (!ncstrcmp(s,"slash"))
  951.                 {while (p < q)
  952.                        *t++ = (float)((extended)(*u++) / (extended)(*p++));
  953.                  *t = (float)((extended)(*u) / (extended)(*p));
  954.                 }
  955.         else    unknown(s,d,e,a);
  956.        }
  957.     return;
  958. }
  959.